home *** CD-ROM | disk | FTP | other *** search
/ Varios Español / Varios Español.iso / CLIPP52 / TCBLLIB2.ZIP / DBU.PRG < prev    next >
Text File  |  1993-11-06  |  29KB  |  936 lines
  1. /***
  2. *
  3. *  Dbu.prg
  4. *
  5. *  DBU Main Module
  6. *
  7. *  Copyright (c) 1990-1993, Computer Associates International, Inc.
  8. *  All rights reserved.
  9. *
  10. */
  11.  
  12. #INCLUDE "llibg.ch"           //-LLIBG- include definitions file
  13.  
  14. PROCEDURE Dbu( param1, param2, param3 )
  15.  
  16.  
  17.    PUBLIC n_files,keystroke,lkey,frame,sframe,cur_dir,more_up,more_down,;
  18.    kf1,kf2,kf3,kf4,kf5,kf6,need_field,need_ntx,need_relat,need_filtr,;
  19.    help_code,view_err,cur_area,cur_dbf,cur_ntx,cur_fields,error_on,;
  20.    exit_str,page,sysfunc,func_sel,cur_func,local_func,local_sel,box_open,;
  21.    color1,color2,color3,color4,color5,color6,color7,color8,color9,;
  22.    color10,color11,color12,com_line,curs_on,helpfile
  23.  
  24.    PUBLIC lIsGraf   := .F.      //-LLIBG- Light Lib Graphics
  25.    PUBLIC xSaveBack := NIL      //        Declare PUBLIC variable to define
  26.    PUBLIC nUserMode := 0        //        whether display is Graphic or Text mode,
  27.                                 //        and handle for savescreen
  28.  
  29.  
  30.    ******
  31.    *  The parameters are optional and have the following meaning:
  32.    *
  33.    *  - filename (.VEW or .DBF) to Browse
  34.    *
  35.    *  - color directive where:
  36.    *     /C = use color even if monochrome
  37.    *     /M = monochrome (don't use color)
  38.    *     /G = use Graphics mode
  39.    *
  40.    *  - file opening mode (for network support)
  41.    *     /E = exclusive use of files
  42.    *
  43.    *  Parameters may be specified in any order
  44.    ******
  45.  
  46.    * avoid a type mismatch & convert to uppercase
  47.    IF VALTYPE( param1 ) != "C"
  48.       param1 = ""
  49.    ENDIF
  50.  
  51.    IF VALTYPE( param2 ) != "C"
  52.       param2 = ""
  53.    ENDIF
  54.  
  55.    IF VALTYPE( param3 ) != "C"
  56.       param3 := ""
  57.    ENDIF
  58.  
  59.    // Combine all the command line params together
  60.    param1 := UPPER( param1 + "~" + param2 + "~" + param3 + "~" )
  61.  
  62.    // Process the command line parameters where com_line will contain the
  63.    // view/file name to open and param2 will contain the color directive
  64.    param3 := ParseCommLine( param1 )
  65.    com_line := param3[1]
  66.    param2   := param3[2]
  67.  
  68.    SET CURSOR OFF                                && cursors are for gets
  69.    SAVE SCREEN                                   && the screen you save...
  70.    SET SCOREBOARD OFF                            && who's keeping score, anyhow
  71.    SET KEY 28 TO                                 && some folks need help
  72.  
  73.    IF "/G" $ UPPER(param1)
  74.                              //       Light Lib Graphics
  75.                              //       Display mode is determined by using
  76.                              //       /G in DBU command line
  77.  
  78.  
  79.       lIsGraf := .T.
  80.  
  81.                              //-LLIBG- Light Lib Graphics
  82.                              //        Color set for graphic mode might be slightly
  83.                              //        different due to enhanced display
  84.  
  85.       color1 = "B/W+,N/W+,B"        // .normal
  86.       color2 = "N/W+"               // .item hilite
  87.       color3 = "W+/R"               // error or high intensity
  88.       color4 = "R/W+,N/W+,,,N/W+"   // achoice/list array..unselected is norm
  89.       color5 = "N/W,W+/N,,,W+/W"    // achoice/sysmenu..true unselected
  90.       color6 = "W+/BG"              // menu frame
  91.       color7 = "N/W+,B/BG"          // .browse, modify structure, set relation
  92.       color8 = "B/W,B/BG,,,B/W"     // memos, dialogue
  93.       color9 = "W+/B,N/BG"          // memo titles
  94.       color10 = "B/BG"              // dialogue box hilite
  95.       color11 = "W+/BG"             // menu title hilite
  96.       color12 = "W+/B"              // set relation hilite
  97.  
  98.    ELSE
  99.  
  100.       IF (ISCOLOR() .OR. "/C" $ UPPER(param2)) .AND. .NOT. "/M" $ UPPER(param2)
  101.  
  102.         * make it pretty
  103.         color1 = "W+/B,N/W,B"                      && normal
  104.         color2 = "B/W"                             && item hilite
  105.         color3 = "W+/R"                            && error or high intensity
  106.         color4 = "W+/B,B/W,,,W+/B"                 && achoice/list array..unselected is norm
  107.         color5 = "B/BG,B/W,,,W/BG"                 && achoice/sysmenu..true unselected
  108.         color6 = "W+/BG"                           && menu frame
  109.         color7 = "B/BG,B/W"                        && browse, modify structure, set relation
  110.         color8 = "B/W,B/BG,,,B/W"                  && memos, dialogue
  111.         color9 = "W+/B,N/BG"                       && memo titles
  112.         color10 = "B/BG"                           && dialogue box hilite
  113.         color11 = "W+/BG"                          && menu title hilite
  114.         color12 = "W+/B"                           && set relation hilite
  115.  
  116.       ELSE
  117.  
  118.         * monochrome
  119.         color1 = "W/N,N/W"
  120.         color2 = "N/W"
  121.         color3 = "W+/N"
  122.         color4 = "W/N,N/W,,,W/N"
  123.         color5 = "W+/N,N/W,,,W/N"
  124.         color6 = "W/N"
  125.         color7 = "W/N,N/W"
  126.         color8 = "W/N,N/W,,,W/N"
  127.         color9 = "N/W,N/W"
  128.         color10 = "N/W"
  129.         color11 = "N/W"
  130.         color12 = "W+/N"
  131.  
  132.       ENDIF
  133.  
  134.    ENDIF
  135.    * let's get this baby off the ground
  136.    SetColor(color1)
  137.    CLEAR
  138.  
  139.    * system constants
  140.    more_up = CHR(24)                             && visual up arrow
  141.    more_down = CHR(25)                           && visual down arrow
  142.  
  143.    IF lIsGraf                //-LLIBG- Enter graphic mode
  144.  
  145.                              // nChooseVideoMode() is a CLIPPER function
  146.                              // (see LLibgToo.prg). It allows user to choose
  147.                              // from all video modes availables
  148.  
  149.       IF (nUserMode := nChooseVideoMode())==0
  150.  
  151.          QUIT                // User strike ESC or no graphics modes available
  152.  
  153.       ELSE
  154.  
  155.          gMode( nUserMode )  // Turn in the choosen graphics mode
  156.                              // for exemple gMode(LLG_VIDEO_VGA_640_480_16)
  157.  
  158.                              // Display Wall Paper with WallPaper(FileName)
  159.                              // This little CLIPPER function
  160.                              // use LLIBG calls. See LLibgToo.prg
  161.  
  162.          IF gMode()[LLG_MODE_COLOR_MAX]==256
  163.                              // If 256 color are available display a
  164.                              // 256 colors BMP
  165.             WallPaper("256.BMP")
  166.  
  167.          ELSE                // Else display a 16 colors BMP
  168.  
  169.             WallPaper("LEAVES.BMP")
  170.  
  171.          ENDIF
  172.  
  173.          xSaveBack := SAVESCREEN(03,00,MAXROW()-4,MAXCOL())
  174.  
  175.          frame  = LLG_BOX_GRAY_STD  // When in graphic mode, box frame
  176.          lframe = LLG_BOX_GRAY_STD  // should be redefined
  177.          mframe = LLG_BOX_GRAY_STD  //
  178.          sframe = LLG_BOX_GRAY_STD
  179.  
  180.       ENDIF
  181.  
  182.    ELSE
  183.  
  184.       frame = "╒═╕│╛═╘│"         && box characters
  185.       lframe = "╤═╕│╛═╧│"
  186.       mframe = "┬─┬│┘─└│"
  187.       sframe = "┌─┐│┘─└│"
  188.  
  189.    ENDIF
  190.  
  191.    * global variables
  192.    STORE .F. TO need_field,need_ntx,need_relat,need_filtr,box_open
  193.    STORE "" TO kf1,kf2,kf3,kf4,kf5,kf6
  194.    help_code = 0                                 && let them eat cake
  195.    curs_on = .F.                                 && what cursor?
  196.    cur_dir = ""                                  && current directory
  197.    cur_dbf = ""                                  && current data file
  198.    cur_ntx = ""                                  && current controlling index file
  199.    cur_fields = ""                               && fields array for current area
  200.    cur_area = 0                                  && current work area
  201.    page = 1                                      && active view screen
  202.    n_files = 0                                   && 14 user files max
  203.    view_file = ""                                && file to save view
  204.    view_err = ""                                 && displayed by "set_view"
  205.  
  206.    view_err = "DBU - Copyright (c) Computer Associates Int'l, " +;
  207.    "All Rights Reserved. /G Graphics "
  208.  
  209.    * search for help file
  210.    IF FILE( "dbu.hlp" )
  211.       helpfile := "dbu.hlp"
  212.  
  213.    ELSE
  214.       helpfile := GetHelpFile()
  215.  
  216.    ENDIF
  217.  
  218.    **
  219.    *  Arrays declared in main module are considered public and
  220.    *  may be accessed or altered by any module in the system. The
  221.    *  matrix defines 6 work areas with 7 indexes and 64 fields
  222.    *  for each. 15 relations are also provided. All elements are
  223.    *  initialized to avoid a type mismatch.
  224.    **
  225.  
  226.    * names of data files
  227.    DECLARE dbf[6]
  228.  
  229.    * names of index files
  230.    DECLARE ntx1[7]
  231.    DECLARE ntx2[7]
  232.    DECLARE ntx3[7]
  233.    DECLARE ntx4[7]
  234.    DECLARE ntx5[7]
  235.    DECLARE ntx6[7]
  236.  
  237.    * 15 relations
  238.    DECLARE s_relate[15]                          && source of relation
  239.    DECLARE k_relate[15]                          && key to relation
  240.    DECLARE t_relate[15]                          && target of relation
  241.  
  242.    * individual field names for active list
  243.    DECLARE field_n1[64]
  244.    DECLARE field_n2[64]
  245.    DECLARE field_n3[64]
  246.    DECLARE field_n4[64]
  247.    DECLARE field_n5[64]
  248.    DECLARE field_n6[64]
  249.  
  250.    * master field list..128 fields overall max
  251.    DECLARE field_list[128]
  252.  
  253.    * first and last row of each screen section
  254.    DECLARE row_a[3]                              && first row of each screen section
  255.    DECLARE row_x[3]                              && last row of each screen sectionn
  256.  
  257.    * constant values
  258.    row_a[1] = 6
  259.    row_x[1] = 6
  260.    row_a[2] = 10
  261.    row_x[2] = 12
  262.    row_a[3] = 16
  263.    row_x[3] = 22
  264.  
  265.    * col() of data file columns
  266.    DECLARE column[6]
  267.  
  268.    * current row for each data column and each screen section
  269.    DECLARE _cr1[3]
  270.    DECLARE _cr2[3]
  271.    DECLARE _cr3[3]
  272.    DECLARE _cr4[3]
  273.    DECLARE _cr5[3]
  274.    DECLARE _cr6[3]
  275.  
  276.    * current element for each data column and each screen section
  277.    DECLARE _el1[3]
  278.    DECLARE _el2[3]
  279.    DECLARE _el3[3]
  280.    DECLARE _el4[3]
  281.    DECLARE _el5[3]
  282.    DECLARE _el6[3]
  283.  
  284.    * titles for function keys and help screens
  285.    DECLARE func_title[8]
  286.    DECLARE menu_deflt[8]
  287.    DECLARE help_title[22]
  288.  
  289.    **
  290.    * initialize arrays
  291.    **
  292.  
  293.    * active data files
  294.    afill(dbf, "")
  295.  
  296.    * index files for each data file
  297.    afill(ntx1, "")
  298.    afill(ntx2, "")
  299.    afill(ntx3, "")
  300.    afill(ntx4, "")
  301.    afill(ntx5, "")
  302.    afill(ntx6, "")
  303.  
  304.    * fields for each data file
  305.    afill(field_n1, "")
  306.    afill(field_n2, "")
  307.    afill(field_n3, "")
  308.    afill(field_n4, "")
  309.    afill(field_n5, "")
  310.    afill(field_n6, "")
  311.  
  312.    * source, key, and target for relations
  313.    afill(s_relate, "")
  314.    afill(k_relate, "")
  315.    afill(t_relate, "")
  316.  
  317.    * master field list
  318.    afill(field_list, "")
  319.  
  320.    * titles for function keys
  321.    func_title[1] = "Help"
  322.    func_title[2] = "Open"
  323.    func_title[3] = "Create"
  324.    func_title[4] = "Save"
  325.    func_title[5] = "Browse"
  326.    func_title[6] = "Utility"
  327.    func_title[7] = "Move"
  328.    func_title[8] = "Set"
  329.  
  330.    afill(menu_deflt, 1)
  331.  
  332.    * draw top of screen rows 0 thru 3
  333.    IF lIsGraf                   //-LLIBG- If in graphic mode,
  334.                                 //        initialize  function keys labels whith
  335.                                 //        with graphic box arround
  336.  
  337.        DispBox(  00,                             ;  // Top
  338.                  00,                             ;  // Left
  339.                  02,                             ;  // Bottom
  340.                  MAXCOL(),                       ;  // Right
  341.                  chr(1)+chr(8)+chr(16)+chr(9) +  ;  // Colors of frame
  342.                  chr(4)+chr(4)+chr(4)+chr(4) )      // Width of frame
  343.  
  344.        gWriteAt( 10, 03, "F1        "+;             // Write labels in
  345.                          "F2        "+;             // transparency mode
  346.                          "F3        "+;
  347.                          "F4        "+;
  348.                          "F5        "+;
  349.                          "F6        "+;
  350.                          "F7        "+;
  351.                          "F8       " ,;
  352.                       1, LLG_MODE_SET )
  353.  
  354.       show_keys()
  355.       stat_msg('')
  356.  
  357.    ELSE
  358.  
  359.       @ 0,0 SAY " F1        F2        F3        F4        F5        F6        " +;
  360.       "F7        F8       "
  361.       show_keys()
  362.       @ 2,0 SAY REPLICATE("─", 80)
  363.  
  364.    ENDIF
  365.  
  366.    error_msg(view_err)
  367.  
  368.    * when to bubble up
  369.    exit_str = "356"
  370.  
  371.    * pop-up menus with parallel boolean arrays for achoice()
  372.    DECLARE help_m[1]
  373.    DECLARE help_b[1]
  374.    help_m[1] = "Help"
  375.    help_b[1] = .T.
  376.  
  377.    DECLARE open_m[3]
  378.    DECLARE open_b[3]
  379.    open_m[1] = "Database"
  380.    open_m[2] = "Index"
  381.    open_m[3] = "View"
  382.    open_b[1] = "sysfunc = 0 .AND. .NOT. box_open"
  383.    open_b[2] = "sysfunc = 0 .AND. .NOT. box_open .AND. .NOT. EMPTY(cur_dbf)"
  384.    open_b[3] = "sysfunc = 0 .AND. .NOT. box_open"
  385.  
  386.    DECLARE create_m[2]
  387.    DECLARE create_b[2]
  388.    create_m[1] = "Database"
  389.    create_m[2] = "Index"
  390.    create_b[1] = "sysfunc = 0"
  391.    create_b[2] = "sysfunc = 0 .AND. .NOT. EMPTY(cur_dbf)"
  392.  
  393.    DECLARE save_m[2]
  394.    DECLARE save_b[2]
  395.    save_m[1] = "View"
  396.    save_m[2] = "Struct"
  397.    save_b[1] = "sysfunc = 0 .AND. .NOT. box_open"
  398.    save_b[2] = "sysfunc = 3 .AND. func_sel = 1 .AND. .NOT. box_open"
  399.  
  400.    IF lIsGraf                   //-LLIBG- Add a new option to menu
  401.                                 //        Allow graphic browse when in graphic mode
  402.       DECLARE browse_m[3]
  403.       DECLARE browse_b[3]
  404.    ELSE
  405.       DECLARE browse_m[2]
  406.       DECLARE browse_b[2]
  407.    ENDIF
  408.  
  409.    browse_m[1] = "Database"
  410.    browse_m[2] = "View"
  411.    browse_b[1] = "sysfunc = 0 .AND. .NOT. EMPTY(cur_dbf)"
  412.    browse_b[2] = "sysfunc = 0 .AND. .NOT. EMPTY(dbf[1])"
  413.  
  414.    IF lIsGraf                   //-LLIBG- Add a new option to menu
  415.                                 //        Allow graphic browse when in graphic mode
  416.       browse_m[3] = "Graphic"
  417.       browse_b[3] = "sysfunc = 0 .AND. .NOT. EMPTY(cur_dbf)"
  418.    ENDIF
  419.  
  420.    IF lIsGraf                   //-LLIBG- Add one option to menu
  421.       DECLARE utility_m[7]      //        for gets/browse and others samples
  422.       DECLARE utility_b[7]
  423.    ELSE
  424.       DECLARE utility_m[6]
  425.       DECLARE utility_b[6]
  426.    ENDIF
  427.  
  428.    utility_m[1] = "Copy"
  429.    utility_m[2] = "Append"
  430.    utility_m[3] = "Replace"
  431.    utility_m[4] = "Pack"
  432.    utility_m[5] = "Zap"
  433.    utility_m[6] = "Run"
  434.    afill(utility_b, "sysfunc = 0 .AND. .NOT. EMPTY(cur_dbf)", 1, 5)
  435.    utility_b[6] = "sysfunc = 0"
  436.  
  437.    IF lIsGraf                   //-LLIBG- Add a new option to menu
  438.                                 //        add graphic editor
  439.       utility_m[7] = "Samples"
  440.       utility_b[7] = "sysfunc = 0"
  441.    ENDIF
  442.  
  443.    DECLARE move_m[4]
  444.    DECLARE move_b[4]
  445.    move_m[1] = "Seek"
  446.    move_m[2] = "Goto"
  447.    move_m[3] = "Locate"
  448.    move_m[4] = "Skip"
  449.    afill(move_b, "sysfunc = 5 .AND. .NOT. box_open")
  450.    move_b[1] = move_b[1] + " .AND. .NOT. EMPTY(cur_ntx)"
  451.  
  452.    DECLARE set_m[3]
  453.    DECLARE set_b[3]
  454.    set_m[1] = "Relation"
  455.    set_m[2] = "Filter"
  456.    set_m[3] = "Fields"
  457.    set_b[1] = "sysfunc = 0 .AND. .NOT. box_open .AND. .NOT. EMPTY(dbf[2])"
  458.    set_b[2] = "sysfunc = 0 .AND. .NOT. box_open .AND. .NOT. EMPTY(cur_dbf)"
  459.    set_b[3] = "sysfunc = 0 .AND. .NOT. box_open .AND. .NOT. EMPTY(cur_dbf)"
  460.  
  461.  
  462.    * titles for help screens
  463.    help_title[1] = "GENERAL INFORMATION"
  464.    help_title[2] = "FIELDS LISTS"
  465.    help_title[3] = "BROWSE"
  466.    help_title[4] = "CREATE / MODIFY STRUCTURE"
  467.    help_title[5] = "CREATE INDEX"
  468.    help_title[6] = "OPEN DATABASE"
  469.    help_title[7] = "FILTERS"
  470.    help_title[8] = "OPEN INDEX"
  471.    help_title[9] = "SET RELATIONSHIP"
  472.    help_title[10] = "LOCATE EXPRESSION"
  473.    help_title[11] = "SDF / DELIMITED"
  474.    help_title[12] = "COPY"
  475.    help_title[13] = "SEEK EXPRESSION"
  476.    help_title[14] = "GO TO RECORD NUMBER"
  477.    help_title[15] = "APPEND"
  478.    help_title[16] = "FOR / WHILE"
  479.    help_title[17] = "SCOPE"
  480.    help_title[18] = "DOS WINDOW"
  481.    help_title[19] = "MEMO EDITOR"
  482.    help_title[20] = "SKIP <n> RECORDS"
  483.    help_title[21] = "SAVE / RESTORE VIEW"
  484.    help_title[22] = "REPLACE"
  485.  
  486.    * arrays for file names in default directory
  487.    DECLARE dbf_list[adir("*.DBF") + 20]          && directory of data files
  488.    DECLARE ntx_list[adir("*" + INDEXEXT()) + 20] && directory of index files
  489.    DECLARE vew_list[adir("*.VEW") + 20]          && directory of view files
  490.  
  491.    * fill the arrays with filenames
  492.    array_dir("*.DBF",dbf_list)
  493.    array_dir("*" + INDEXEXT(),ntx_list)
  494.    array_dir("*.VEW",vew_list)
  495.  
  496.    * default to set view
  497.    local_func = 0                                && local menu
  498.    local_sel = 1                                 && local menu item
  499.    keystroke = 0                                 && current keystroke
  500.    lkey = 0                                      && previous keystroke
  501.    sysfunc = 0                                   && system menu
  502.    func_sel = 1                                  && system menu item
  503.  
  504.    * clean up and process command line if entered
  505.    com_line = LTRIM(TRIM(com_line))
  506.  
  507.    IF .NOT. EMPTY(com_line)
  508.  
  509.       DO CASE
  510.  
  511.       CASE RAT(".", com_line) > RAT("\", com_line)
  512.          * file extension entered
  513.          IF .NOT. FILE(com_line)
  514.             * file must exist
  515.             com_line = ""
  516.  
  517.          ENDIF
  518.  
  519.       CASE FILE(com_line + ".VEW")
  520.          * look for file name with .VEW extension
  521.          com_line = com_line + ".VEW"
  522.  
  523.       CASE FILE(com_line + ".DBF")
  524.          * look for file name with .DBF extension
  525.          com_line = com_line + ".DBF"
  526.  
  527.       OTHERWISE
  528.          * file not found..ignore command line
  529.          com_line = ""
  530.  
  531.       ENDCASE
  532.  
  533.       IF .NOT. EMPTY(com_line)
  534.          * command line file exists
  535.  
  536.          IF RAT(".VEW", com_line) = LEN(com_line) - 3
  537.             * assume a valid .VEW file
  538.             view_file = com_line
  539.             set_from(.F.)                        && restore view
  540.             KEYBOARD CHR(-4) + CHR(24) + CHR(13) && browse view
  541.  
  542.          ELSE
  543.             * assume a valid .DBF file
  544.             dbf[1] = com_line                    && primary database
  545.  
  546.             IF NetUse( com_line )
  547.                all_fields(1, M->field_n1)        && all fields active
  548.                KEYBOARD CHR(-4) + CHR(13)        && browse database
  549.             ELSE
  550.                dbf[1] := ""
  551.             ENDIF
  552.  
  553.          ENDIF
  554.  
  555.          IF .NOT. EMPTY(dbf[1])
  556.             * view established..cancel display of message
  557.             view_err = ""
  558.          ENDIF
  559.       ENDIF
  560.    ENDIF
  561.  
  562.    DO WHILE .T.
  563.       * forever
  564.       cur_func = M->sysfunc                      && to recognize a change
  565.  
  566.       DO CASE
  567.  
  568.       CASE M->sysfunc = 5
  569.          * browse
  570.  
  571.          IF .NOT. EMPTY(dbf[1])
  572.             * there is a view..do the set up
  573.             setup()
  574.  
  575.             IF EMPTY(M->view_err)
  576.                * set up successful so far
  577.                cur_fields = "field_n" + SUBSTR("123456", M->cur_area, 1)
  578.  
  579.                DO CASE
  580.  
  581.                CASE M->func_sel = 1 .AND. EMPTY(M->cur_dbf)
  582.                   * browse one file
  583.                   view_err = "No data file in current select area"
  584.  
  585.                CASE M->func_sel = 1 .AND. EMPTY(&cur_fields[1])
  586.                   * browse one file
  587.                   view_err = "No active field list in current select area"
  588.  
  589.                CASE EMPTY(field_list[1])
  590.                   * browse entire view
  591.                   view_err = "No active field list"
  592.  
  593.                              //-LLIBG- Call graphic browse
  594.                CASE lIsGraf .AND.  M->func_sel = 3
  595.                   SampleBrowse(03, 04, MAXROW()-4, MAXCOL()-4)
  596.  
  597.                OTHERWISE
  598.                   * ok to browse
  599.  
  600.                   IF M->func_sel = 1
  601.                      * browse one file..hi-lite the name
  602.                      hi_cur()
  603.  
  604.                   ENDIF
  605.  
  606.                   help_code = 3
  607.                   DO browse
  608.                   dehi_cur()
  609.  
  610.                ENDCASE
  611.             ENDIF
  612.  
  613.          ELSE
  614.             view_err = "No database in use"
  615.  
  616.          ENDIF
  617.  
  618.          sysfunc = 0                             && back to the main view screen
  619.  
  620.       CASE M->sysfunc = 3
  621.  
  622.          IF M->func_sel = 1
  623.             * modify structure
  624.             hi_cur()
  625.             help_code = 4
  626.             DO modi_stru
  627.             dehi_cur()
  628.  
  629.             IF EMPTY(M->cur_dbf)
  630.                * new structure not created..kill dummy View channel
  631.                cur_area = 0
  632.  
  633.             ENDIF
  634.  
  635.          ELSE
  636.             * create or re-create index
  637.  
  638.             IF EMPTY(M->cur_dbf)
  639.                view_err = "No data file in current select area"
  640.  
  641.             ELSE
  642.                help_code = 5
  643.                DO make_ntx
  644.  
  645.             ENDIF
  646.          ENDIF
  647.  
  648.          sysfunc = 0                             && back to the main view screen
  649.  
  650.                              //-LLIBG- Call Samples
  651.       CASE M->sysfunc = 6 .AND. M->func_sel = 7
  652.          ButtonSample()
  653.             sysfunc = 0            && back to the main view screen
  654.  
  655.       CASE M->sysfunc = 6 .AND. M->func_sel <> 6
  656.          * copy/append/replace/pack/zap
  657.  
  658.          IF EMPTY(M->cur_dbf)
  659.             view_err = "No data file in current select area"
  660.             sysfunc = 0                          && back to the main view screen
  661.             LOOP
  662.  
  663.          ENDIF
  664.  
  665.          IF .NOT. EMPTY(dbf[1])
  666.             * do view set up
  667.             setup()
  668.  
  669.          ENDIF
  670.  
  671.          IF .NOT. EMPTY(M->view_err)
  672.             * error in set up
  673.             sysfunc = 0                          && back to the main view screen
  674.             LOOP
  675.  
  676.          ENDIF
  677.  
  678.          hi_cur()
  679.  
  680.          DO CASE
  681.  
  682.          CASE M->func_sel < 4
  683.             * copy, append, or replace
  684.             DO capprep
  685.  
  686.          CASE M->func_sel = 4
  687.             * pack command
  688.  
  689.             IF rsvp("Pack " + M->cur_dbf + "? (Y/N)") = "Y"
  690.                * pack confirmed
  691.                stat_msg("Packing " + M->cur_dbf)
  692.                SELECT (M->cur_area)
  693.                IF NetPack()
  694.                   stat_msg(M->cur_dbf + " Packed")
  695.                ELSE
  696.                   /*
  697.                   IF !NetUse( M->cur_dbf )
  698.                      /// If we can't re-open, we're in trouble...
  699.                      ALERT( "Assertion failed:;Unable to re-open file" )
  700.                      QUIT
  701.                   ENDIF
  702.                   */
  703.                   clear_dbf(M->cur_area, 2)
  704.                   cur_dbf = dbf[M->cur_area]
  705.                   stat_msg("")
  706.                ENDIF
  707.  
  708.             ENDIF
  709.  
  710.          CASE M->func_sel = 5
  711.             * zap command
  712.  
  713.             IF rsvp("Zap " + M->cur_dbf + "? (Y/N)") = "Y"
  714.                * zap confirmed
  715.                stat_msg("Zapping " + M->cur_dbf)
  716.                SELECT (M->cur_area)
  717.                IF NetZap()
  718.                   stat_msg(M->cur_dbf + " Zapped")
  719.                ELSE
  720.                   /*
  721.                   IF !NetUse( M->cur_dbf )       //Attempt to re-open shared
  722.                      /// If we can't re-open, we're in trouble...
  723.                      ALERT( "Assertion failed:;Unable to re-open file" )
  724.                      QUIT
  725.                   ENDIF
  726.                   */
  727.                   clear_dbf(M->cur_area, 2)
  728.                   cur_dbf = dbf[M->cur_area]
  729.                   stat_msg("")
  730.                ENDIF
  731.  
  732.             ENDIF
  733.  
  734.          ENDCASE
  735.  
  736.          dehi_cur()
  737.          sysfunc = 0                             && back to the main view screen
  738.  
  739.       CASE M->sysfunc = 6 .AND. M->func_sel = 6
  740.          * run a DOS command or program
  741.          IF lIsGraf                //-LLIBG- Do not clear message and status area
  742.             @ 3,0 CLEAR TO MAXROW(),MAXCOL()
  743.          ELSE
  744.             @ 4,0 CLEAR            // Clear all bottom area
  745.          ENDIF
  746.  
  747.          IF .NOT. EMPTY(dbf[1])
  748.             * set view before a possible chdir
  749.             setup()
  750.  
  751.          ENDIF
  752.  
  753.          IF .NOT. EMPTY(M->view_err)
  754.             * display message and continue for possible
  755.             * correction of "File not found", etc.
  756.             error_msg(M->view_err, 24, 7)
  757.             view_err = ""
  758.  
  759.          ENDIF
  760.  
  761.          run_com = ""
  762.          com_line = ""
  763.          help_code = 18
  764.  
  765.          DO WHILE .NOT. q_check()
  766.                 * re-draw top 3 rows after each command
  767.             IF lIsGraf                 //-LLIBG- If in graphic mode,
  768.                                        //        initialize  function keys labels whith
  769.                                        //        with graphic box arround
  770.                DispBox( 00,                             ;  // Top
  771.                         00,                             ;  // Left
  772.                         02,                             ;  // Bottom
  773.                         MAXCOL(),                       ;  // Right
  774.                         chr(1)+chr(8)+chr(16)+chr(9) +  ;  // Colors of frame
  775.                         chr(4)+chr(4)+chr(4)+chr(4) )      // Width of frame
  776.  
  777.                gWriteAt( 10, 03, "F1        "+; // Write keys labels in
  778.                                  "F2        "+; // transparency mode
  779.                                  "F3        "+;
  780.                                  "F4        "+;
  781.                                  "F5        "+;
  782.                                  "F6        "+;
  783.                                  "F7        "+;
  784.                                  "F8       " ,;
  785.                               1, LLG_MODE_SET )
  786.                show_keys()
  787.                stat_msg('')
  788.             ELSE
  789.                @ 0,0 SAY " F1        F2        F3        F4        " +;
  790.                        "F5        F6        F7        F8       "
  791.                show_keys()
  792.                @ 2,0 SAY REPLICATE("─", 80)
  793.             ENDIF
  794.             @ 24,0 SAY "Run ═" + CHR(16) + " "
  795.  
  796.             * accept command entry
  797.             run_com = enter_rc(M->com_line,24,7,127,"@KS73",M->color1)
  798.  
  799.             IF .NOT. EMPTY(M->run_com) .AND. M->keystroke = 13
  800.                * only the enter key will run the command
  801.                com_line = M->run_com             && preserve previous command
  802.                @ 24,0                            && clear the command entry
  803.  
  804.                SET CURSOR ON
  805.                RUN &run_com
  806.                SET CURSOR OFF
  807.  
  808.             ELSE
  809.                * check for menu request
  810.                sysmenu()
  811.  
  812.                IF M->local_func = 1
  813.                   DO syshelp
  814.  
  815.                ENDIF
  816.             ENDIF
  817.          ENDDO
  818.  
  819.          * re-establish the environment
  820.          @ 3,0 CLEAR
  821.  
  822.          * rebuild directory arrays..must keep current
  823.          DECLARE dbf_list[adir("*.DBF") + 20]
  824.          DECLARE ntx_list[adir("*" + INDEXEXT()) + 20]
  825.          DECLARE vew_list[adir("*.VEW") + 20]
  826.  
  827.          * fill the arrays with filenames..data files
  828.          array_dir("*.DBF",dbf_list)
  829.  
  830.          * index files
  831.          array_dir("*" + INDEXEXT(),ntx_list)
  832.  
  833.          * view files
  834.          array_dir("*.VEW",vew_list)
  835.          cur_area = 0                            && re-draw view screen
  836.          sysfunc = 0                             && back to the main view screen
  837.  
  838.       OTHERWISE
  839.          * main view screen..sysfunc = 0
  840.          help_code = 1
  841.          DO set_view
  842.  
  843.          IF M->keystroke = 27
  844.             * exit confirmed in set_view
  845.             SET TYPEAHEAD TO 0                   && remaining keystrokes to DOS
  846.             CLOSE DATABASES                      && kill the view
  847.             RESTORE SCREEN                       && ...may be your own
  848.             SET CURSOR ON                        && always leave them laughing
  849.             SET COLOR TO                         && back to normal
  850.             QUIT                                 && -=[Bye]=-
  851.  
  852.          ENDIF
  853.       ENDCASE
  854.    ENDDO
  855.  
  856.    RETURN
  857.  
  858.  
  859.  
  860. /***
  861. *
  862. *  ParseCommLine( cCommandLine ) --> { cFile, cColorDescriptor }
  863. *
  864. */
  865. FUNCTION ParseCommLine( cStr )
  866.    LOCAL aRet := { "", "" }                   // Return value containing file and colors
  867.    LOCAL nPos := 1                            // Position of next token in string
  868.    LOCAL cToken                               // Extracted command line parameter
  869.  
  870.    WHILE ( nPos != 0 )
  871.  
  872.       IF (( nPos := AT( "~", cStr ) ) != 0 )
  873.  
  874.          cToken := SUBSTR( cStr, 1, nPos - 1 )
  875.          cStr   := SUBSTR( cStr, ++nPos )
  876.  
  877.          DO CASE
  878.          CASE ( cToken == "/E" )
  879.             NetMode( .F. )
  880.  
  881.          CASE ( cToken $ "/C/M" )
  882.             aRet[2] := cToken
  883.  
  884.          CASE !( cToken == "" )
  885.             aRet[1] := cToken
  886.  
  887.          ENDCASE
  888.  
  889.       ENDIF
  890.  
  891.    ENDDO
  892.  
  893.    RETURN ( aRet )
  894.  
  895.  
  896.  
  897. /***
  898. *
  899. *  GetHelpFile() --> cHelpFile
  900. *
  901. */
  902. FUNCTION GetHelpFile()
  903.    LOCAL cPath := GETENV( "PATH" )
  904.    LOCAL nPos  := 1
  905.    LOCAL cFile
  906.    LOCAL lFound
  907.  
  908.    WHILE ( nPos != 0 )
  909.  
  910.       nPos  := AT( ";", cPath )
  911.  
  912.       // Account for backslash in path
  913.       IF ( SUBSTR( cPath, nPos - 1, 1 ) == "\" )
  914.          cFile := SUBSTR( cPath, 1, IF( nPos == 0, LEN( cPath ), nPos - 1 )) + "dbu.hlp"
  915.       ELSE
  916.          cFile := SUBSTR( cPath, 1, IF( nPos == 0, LEN( cPath ), nPos - 1 )) + "\dbu.hlp"
  917.       ENDIF
  918.  
  919.       IF FILE( cFile )
  920.          EXIT     // We found it, time to bail...
  921.       ENDIF
  922.  
  923.       IF ( nPos == 0 )
  924.          cFile := ""
  925.       ELSE
  926.          cPath := SUBSTR( cPath, nPos + 1 )
  927.       ENDIF
  928.  
  929.    END
  930.  
  931.    RETURN ( cFile )
  932.  
  933.  
  934.  
  935. * EOF DBU.PRG
  936.